home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS13.ADF / AmigaBasicProgs / LibDemos / LoadACBM (.txt) < prev    next >
AmigaBASIC Source Code  |  1986-08-05  |  10KB  |  376 lines
  1. REM - LoadACBM
  2. REM -  by Carolyn Scheppner  CBM  04/86
  3. REM - This program loads an ACBM file
  4. REM -  (Amiga Contiguous BitMap)
  5. REM -  into a custom screen/window
  6. REM -  using DOS library calls
  7. REM - 
  8. REM - Note that the only special chunk
  9. REM -  handled by this loader is the
  10. REM -  CCRT Graphicraft color cycling
  11. REM -  chunk.  The loader is an IFF
  12. REM -  chunk-oriented loader and
  13. REM -  can be easily modified to
  14. REM -  handle additional chunks.
  15.  
  16. REM - Requires exec, graphics and dos
  17. REM -  .bmaps (Use NewConvertFD)
  18. REM
  19.  
  20. REM - Format of ACBM file:
  21. REM -    LONG   "FORM"
  22. REM -    LONG   size of rest of file
  23. REM -    LONG   "ACBM" (form type)
  24. REM 
  25. REM -    LONG   "BMHD" (std IFF BitMap header)
  26. REM -    LONG   size of BMHD chunk = 20
  27. REM -    UWORD  w (bitmap width in pixels)
  28. REM -    UWORD  h (bitmap height)
  29. REM -    WORD   x (nw corner) = 0
  30. REM -    WORD   y (nw corner) = 0
  31. REM -    UBYTE  nPlanes
  32. REM -    UBYTE  masking = 0
  33. REM -    UBYTE  compression = 0
  34. REM -    UBYTE  pad1 = 0
  35. REM -    UWORD  transparentColor = 0
  36. REM -    UBYTE  xAspect (pixel) = 10
  37. REM -    UBYTE  yAspect (pixel) = 11
  38. REM -    WORD   pageWidth (screen width in pixels)    
  39. REM -    WORD   pageHeight (screen height in pixels)
  40. REM 
  41. REM -    LONG   "CMAP" (std IFF ColorMap chunk)
  42. REM -    LONG   size of CMAP chunk
  43. REM -    UBYTE  Sets of 3 UBYTES (red, green, blue)
  44. REM -           (2^nPlanes sets)
  45. REM -           (rgb values LEFT justified in each UBYTE)
  46. REM
  47. REM -    LONG   "CAMG" (Amiga ViewPort Modes)
  48. REM -    LONG   size of CAMG chunk
  49. REM -    LONG   ViewModes
  50. REM
  51. REM -    LONG   "CCRT"  (Graphicraft color cycle info)
  52. REM -    WORD   direction (1,-1, or 0 = none)
  53. REM -    UBYTE  start  (low cycle reg)
  54. REM -    UBYTE  end    (high cycle reg)
  55. REM -    LONG   seconds (cycle time)
  56. REM -    LONG   microseconds (cycle time)
  57. REM -    WORD   pad = 0
  58. REM
  59. REM -    LONG   "ABIT"  (Amiga BitPlanes)
  60. REM -    LONG   size of ABIT chunk
  61. REM -           BitPlanes 0 thru nPlanes - 1
  62. REM -          (each is h * (w/8) bytes)
  63.  
  64.  
  65. Main:
  66.  
  67. PRINT "LoadACBM - ACBM pic file loader"
  68. PRINT
  69. PRINT " This program loads and displays an ACBM pic file."
  70. PRINT "ACBM pic files can be loaded more quickly than ILBMs."
  71. PRINT "IFF ILBM pic files can be converted to ACBM format"
  72. PRINT "with the LoadILBM-SaveACBM program."
  73. PRINT
  74.  
  75. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  76.  
  77. REM - Functions from dos.library                   
  78. DECLARE FUNCTION xOpen&  LIBRARY
  79. DECLARE FUNCTION xRead&  LIBRARY
  80. DECLARE FUNCTION xWrite& LIBRARY
  81. DECLARE FUNCTION IoErr&  LIBRARY
  82. REM - xClose returns no value
  83.  
  84. REM - Functions from exec.library
  85. DECLARE FUNCTION AllocMem&() LIBRARY
  86. REM - FreeMem returns no value
  87.  
  88. PRINT:PRINT "Looking for bmaps ... ";
  89. LIBRARY "dos.library"
  90. LIBRARY "exec.library"
  91. LIBRARY "graphics.library"
  92. PRINT "found them."
  93.  
  94. PRINT:PRINT "ENTER FILESPEC:"
  95. PRINT "( Try  Heart.ACBM, MedRes.ACBM or HiRes.ACBM )"
  96. PRINT
  97. GetNames:
  98. INPUT "   ACBM filespec";ACBMname$
  99. IF (ACBMname$ = "") GOTO Mcleanup2
  100. PRINT
  101.  
  102. REM - Load the ACBM pic
  103. loadError$ = ""
  104. GOSUB LoadACBM
  105. IF loadError$ <> "" THEN GOTO Mcleanup
  106.  
  107. REM - Demo Graphicraft color cycling
  108. IF foundCCRT AND ccrtDir% THEN
  109.    REM - Save colors
  110.    FOR kk = 0 TO nColors% -1
  111.       cTabSave%(kk) = PEEKW(colorTab&+(kk*2))   
  112.       cTabWork%(kk) = cTabSave%(kk)
  113.    NEXT
  114.    
  115.    REM - Cycle colors
  116.    FOR kk = 0 TO 80
  117.       IF ccrtDir% = 1 THEN
  118.          GOSUB Fcycle
  119.       ELSE   
  120.          GOSUB Bcycle
  121.       END IF
  122.  
  123.       CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
  124.       REM - Delays approximated
  125.       FOR de1 = 0 TO ccrtSecs& * 3000
  126.          FOR de2 = 0 TO ccrtMics& / 500
  127.          NEXT
  128.       NEXT
  129.    NEXT
  130.  
  131.    REM - Restore colors
  132.    CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
  133. END IF
  134.  
  135. Mcleanup:
  136. FOR de = 1 TO 20000:NEXT
  137. WINDOW CLOSE 2
  138. SCREEN CLOSE 2
  139.  
  140. Mcleanup2:
  141. LIBRARY CLOSE
  142. IF loadError$ <> "" THEN PRINT loadError$
  143. END
  144.  
  145.  
  146. Bcycle:  'Backward color cycle
  147. cTemp% = cTabWork%(ccrtEnd%)
  148. FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
  149.    cTabWork%(jj+1) = cTabWork%(jj)
  150. NEXT
  151. cTabWork%(ccrtStart%) = cTemp%
  152. RETURN
  153.  
  154. Fcycle:  'Forward color cycle
  155. cTemp% = cTabWork%(ccrtStart%)
  156. FOR jj = ccrtStart%+1 TO ccrtEnd%
  157.    cTabWork%(jj-1) = cTabWork%(jj)
  158. NEXT
  159. cTabWork%(ccrtEnd%) = cTemp%
  160. RETURN
  161.  
  162.  
  163. LoadACBM:
  164. REM - Requires the following variables
  165. REM - to have been initialized:
  166. REM -    ACBMname$ (ACBM filespec)
  167.  
  168. REM - init variables
  169. f$ = ACBMname$
  170. fHandle& = 0
  171. mybuf& = 0
  172. foundBMHD = 0
  173. foundCMAP = 0
  174. foundCAMG = 0
  175. foundCCRT = 0
  176. foundABIT = 0
  177.  
  178. REM - From include/libraries/dos.h
  179. REM - MODE_NEWFILE = 1006 
  180. REM - MODE_OLDFILE = 1005
  181.  
  182. filename$ = f$ + CHR$(0)
  183. fHandle& = xOpen&(SADD(filename$),1005)
  184. IF fHandle& = 0 THEN
  185.    loadError$ = "Can't open/find pic file"
  186.    GOTO Lcleanup
  187. END IF
  188.  
  189.  
  190. REM - Alloc ram for work buffers
  191. ClearPublic& = 65537
  192. mybufsize& = 360
  193. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  194. IF mybuf& = 0 THEN
  195.    loadError$ = "Can't alloc buffer"
  196.    GOTO Lcleanup
  197. END IF
  198.  
  199. inbuf& = mybuf&
  200. cbuf& = mybuf& + 120
  201. ctab& = mybuf& + 240
  202.  
  203.  
  204. REM - Should read  FORMnnnnACBM
  205. rLen& = xRead&(fHandle&,inbuf&,12)
  206. tt$ = ""
  207. FOR kk = 8 TO 11
  208.    tt% = PEEK(inbuf& + kk)
  209.    tt$ = tt$ + CHR$(tt%)
  210. NEXT
  211.  
  212. IF tt$ <> "ACBM" THEN 
  213.    loadError$ = "Not an ACBM pic file"
  214.    GOTO Lcleanup
  215. END IF
  216.  
  217. REM - Read ACBM chunks
  218.  
  219. ChunkLoop:
  220. REM - Get Chunk name/length
  221.  rLen& = xRead&(fHandle&,inbuf&,8)
  222.  icLen& = PEEKL(inbuf& + 4)
  223.  tt$ = ""
  224.  FOR kk = 0 TO 3
  225.     tt% = PEEK(inbuf& + kk)
  226.     tt$ = tt$ + CHR$(tt%)
  227.  NEXT   
  228.     
  229. IF tt$ = "BMHD" THEN  'BitMap header 
  230.    foundBMHD = 1
  231.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  232.    iWidth%  = PEEKW(inbuf&)
  233.    iHeight% = PEEKW(inbuf& + 2)
  234.    iDepth%  = PEEK(inbuf& + 8)  
  235.    iCompr%  = PEEK(inbuf& + 10)
  236.    scrWidth%  = PEEKW(inbuf& + 16)
  237.    scrHeight% = PEEKW(inbuf& + 18)
  238.  
  239.    iRowBytes% = iWidth% /8
  240.    scrRowBytes% = scrWidth% / 8
  241.    nColors%  = 2^(iDepth%)
  242.  
  243.    REM - Enough free ram to display ?
  244.    AvailRam& = FRE(-1)
  245.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  246.    IF AvailRam& < NeededRam& THEN
  247.       loadError$ = "Not enough free ram."
  248.       GOTO Lcleanup
  249.    END IF
  250.  
  251.    kk = 1
  252.    IF scrWidth% > 320 THEN kk = kk + 1
  253.    IF scrHeight% > 200  THEN kk = kk + 2
  254.    SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk
  255.    WINDOW 2,"LoadACBM",,15,2
  256.  
  257.    REM - Get addresses of structures
  258.    GOSUB GetScrAddrs
  259.  
  260.    REM - Black out screen
  261.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  262.  
  263.  
  264. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  265.    foundCMAP = 1
  266.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  267.  
  268.    REM - Build Color Table
  269.    FOR kk = 0 TO nColors% - 1
  270.       red% = PEEK(cbuf&+(kk*3))
  271.       gre% = PEEK(cbuf&+(kk*3)+1)
  272.       blu% = PEEK(cbuf&+(kk*3)+2)
  273.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  274.       POKEW(ctab&+(2*kk)),regTemp%
  275.    NEXT
  276.  
  277.  
  278. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  279.    foundCAMG = 1
  280.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  281.    camgModes& = PEEKL(inbuf&)
  282.  
  283.  
  284. ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
  285.    foundCCRT = 1
  286.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  287.    ccrtDir%    = PEEKW(inbuf&)
  288.    ccrtStart%  = PEEK(inbuf& + 2)
  289.    ccrtEnd%    = PEEK(inbuf& + 3)
  290.    ccrtSecs&   = PEEKL(inbuf& + 4)
  291.    ccrtMics&   = PEEKL(inbuf& + 8)
  292.  
  293.  
  294. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  295.    foundABIT = 1
  296.  
  297.    REM - This only handles full size BitMaps, not brushes
  298.    REM - Very fast - reads in entire BitPlanes
  299.    plSize& = (scrWidth%/8) * scrHeight%
  300.    FOR pp = 0 TO iDepth% -1
  301.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  302.    NEXT
  303.  
  304.  
  305. ELSE 
  306.    REM - Reading unknown chunk  
  307.    FOR kk = 1 TO icLen&
  308.       rLen& = xRead&(fHandle&,inbuf&,1)
  309.    NEXT
  310.    REM - If odd length, read 1 more byte
  311.    IF (icLen& OR 1) = icLen& THEN 
  312.       rLen& = xRead&(fHandle&,inbuf&,1)
  313.    END IF
  314.       
  315. END IF
  316.  
  317.  
  318. REM - Done if got all chunks 
  319. IF foundBMHD AND foundCMAP AND foundABIT THEN
  320.    GOTO GoodLoad
  321. END IF
  322.  
  323. REM - Good read, get next chunk
  324. IF rLen& > 0 THEN GOTO ChunkLoop
  325.  
  326. IF rLen& < 0 THEN  'Read error
  327.    loadError$ = "Read error"
  328.    GOTO Lcleanup
  329. END IF   
  330.  
  331. REM - rLen& = 0 means EOF
  332. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  333.    loadError$ = "Needed ILBM chunks not found"
  334.    GOTO Lcleanup
  335. END IF
  336.  
  337.  
  338. GoodLoad:
  339. loadError$ =""
  340.  
  341. REM  Load proper Colors
  342. IF foundCMAP THEN 
  343.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  344. END IF
  345.  
  346. Lcleanup:
  347. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  348. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  349.  
  350. RETURN
  351.  
  352.  
  353. GetScrAddrs:
  354. REM - Get addresses of screen structures
  355.    sWindow&   = WINDOW(7)
  356.    sScreen&   = PEEKL(sWindow& + 46)
  357.    sViewPort& = sScreen& + 44
  358.    sRastPort& = sScreen& + 84
  359.    sColorMap& = PEEKL(sViewPort& + 4)
  360.    colorTab&  = PEEKL(sColorMap& + 4)
  361.    sBitMap&   = PEEKL(sRastPort& + 4)
  362.  
  363.    REM - Get screen parameters
  364.    scrWidth%  = PEEKW(sScreen& + 12)
  365.    scrHeight% = PEEKW(sScreen& + 14)
  366.    scrDepth%  = PEEK(sBitMap& + 5)
  367.    nColors%   = 2^scrDepth%
  368.  
  369.    REM - Get addresses of Bit Planes 
  370.    FOR kk = 0 TO scrDepth% - 1
  371.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  372.    NEXT
  373. RETURN
  374.  
  375.  
  376.